Unit BEasyLog;

{$mode objfpc}{$H+}
{$define BEasyPublish}

Interface

Uses
  Classes, SysUtils
  {$ifdef BEasyPublish}, fphttpclient, HTTPDefs{$ENDIF};

Const
  ltString = 0;
  ltInteger = 1;
  ltDouble = 1;
  ltDateTime = 2;
  ltObject = 3;
  ltList = 4;
  ltStack = 5;
  ltMethod = 6;
  ltException = 7;


  lkComment = 0;
  lkDebug = 1;
  lkVerbose = 2;
  lkError = 3;

  dfShort = 'dd.mm.yy';
  dfTime = 'hh:mm:ss:zz';

Procedure Log(Const aValue: String; Const aNeedTime: Boolean = FALSE);
Procedure Log(Const aValueMask: String; Const aParams: Array Of Const;
  Const aNeedTime: Boolean = FALSE);
Procedure Log(Const aMessage: String; Const aValue: String;
  Const aHidden: Boolean = FALSE; Const aNeedTime: Boolean = FALSE);
Procedure Log(Const aMessage: String; Const aValueMask: String;
  Const aParams: Array Of Const; Const aHidden: Boolean = FALSE;
  Const aNeedTime: Boolean = FALSE);
Procedure Log(Const aKind: Integer; Const aMessage: String;
  Const aValue: String; Const aNeedTime: Boolean = FALSE);
Procedure Log(Const aKind: Integer; Const aMessage: String;
  Const aValueMask: String; Const aParams: Array Of Const;
  Const aNeedTime: Boolean = FALSE);

Procedure Log(Const aValue: Integer; Const aNeedTime: Boolean = FALSE);
Procedure Log(Const aMessage: String; Const aValue: Integer;
  Const aNeedTime: Boolean = FALSE);
Procedure Log(Const aKind: Integer; Const aMessage: String;
  Const aValue: Integer; Const aNeedTime: Boolean = FALSE);

Procedure Log(Const aValue: Double; Const aNeedTime: Boolean = FALSE);
Procedure Log(Const aMessage: String; Const aValue: Double;
  Const aNeedTime: Boolean = FALSE);
Procedure Log(Const aKind: Integer; Const aMessage: String;
  Const aValue: Double; Const aNeedTime: Boolean = FALSE);

Procedure Log(Const aValue: TDateTime;
  Const aFormat: String = 'dd.mm.yy hh:mm:ss:zz';
  Const aNeedTime: Boolean = FALSE);
Procedure Log(Const aMessage: String; Const aValue: TDateTime;
  Const aFormat: String = 'dd.mm.yy hh:mm:ss:zz';
  Const aNeedTime: Boolean = FALSE);
Procedure Log(Const aKind: Integer; Const aMessage: String;
  Const aValue: TDateTime;
  Const aFormat: String = 'dd.mm.yy hh:mm:ss:zz';
  Const aNeedTime: Boolean = FALSE);

Procedure LogStack(Const aMessage: String = 'Stack';
  Const aNeedTime: Boolean = FALSE);
Procedure LogException(Const aException: Exception);

Procedure LogMethodStart(Const aMethodName: String; Const aParams: String = '';
  Const aNeedTime: Boolean = FALSE);
Procedure LogMethodStart(Const aMethodName: String; Const aParamsMask: String;
  Const aParams: Array Of Const; Const aNeedTime: Boolean = FALSE);
Procedure LogMethodStop(Const aMethodName: String;
  Const aNeedTime: Boolean = FALSE);

Var
  DefaultLogLevel: Integer = lkComment;

Procedure InitLogging;

Implementation

Var
  LogInitiated: Boolean = FALSE;
  LogFile: TFileStream;
  {$IFDEF BEasyPublish}
  aPublisher: TFPHTTPClient;
  {$ENDIF}

Procedure RealLog(Const aKind: Integer; Const aMessage, aValue: String;
  Const aType: Integer; Const aNeedTime: Boolean);
Var
  aBuffer: String = '';
Begin
  If Not(LogInitiated) Then Exit;
  aBuffer := Format('%s:%d:%s', [aMessage , aType, aValue + LineEnding]);
  //LogFile.Write(PChar(aBuffer)[0], Length(aBuffer));
  {$IFDEF BEasyPublish}
  Try
    aPublisher.Get('http://localhost:6556/' + HTTPEncode(Trim(aBuffer)));
  Except
    //TODO: disable publishing
  End;
  {$ENDIF}
End;

Function GetCallStack: String;
var
  i : Longint;
  aPrev, aFrame, aAddr, aPointer: Pointer;
  aBuffer: String;
  aStringList: TStringList;
  aStream: TMemoryStream;
begin
  //routine adapted from fpc source

  //This trick skip SendCallstack item
  //aPointer:=get_frame;
  aPointer := get_caller_frame(get_frame);
  Result := '';
  aStream := TMemoryStream.Create;
  aStringList := TStringList.Create;
  try

    aPrev := aPointer-1;
    i := 0;
    //is_dev:=do_isdevice(textrec(f).Handle);
    While aPointer > aPrev  Do
      Begin
        aAddr := get_caller_addr(aPointer);
        aFrame := get_caller_frame(aPointer);
        If (aAddr = nil) Then
          break;
        //todo: see what is faster concatenate string and use writebuffer or current
        aBuffer := BackTraceStrFunc(aAddr) + LineEnding;
        aStream.WriteBuffer(aBuffer[1],Length(aBuffer));
        Inc(i);
        If Not(i < 50) Or (aFrame = nil) Then
          Break;
        aPrev := aPointer;
        aPointer := aFrame;
      End;
  Except
   { prevent endless dump If an exception occured }
  End;
  aStream.Seek(0, soFromBeginning);
  aStringList.LoadFromStream(aStream);
  Result := aStringList.Text;
  aStream.Free;
  aStringList.Free
End;

Procedure Log(Const aValue: String; Const aNeedTime: Boolean);
Begin
  RealLog(DefaultLogLevel, '', aValue, ltString, aNeedTime);
end;

Procedure Log(Const aValueMask: String; Const aParams: Array Of Const;
  Const aNeedTime: Boolean);
Begin
  Log(Format(aValueMask, aParams), aNeedTime);
end;

Procedure Log(Const aMessage: String; Const aValue: String;
  Const aHidden: Boolean; Const aNeedTime: Boolean);
Begin
  If aHidden Then
    RealLog(DefaultLogLevel, aMessage, aValue, ltList, aNeedTime)
  Else
    RealLog(DefaultLogLevel, aMessage, aValue, ltString, aNeedTime);
end;

Procedure Log(Const aMessage: String; Const aValueMask: String;
  Const aParams: Array Of Const; Const aHidden: Boolean;
  Const aNeedTime: Boolean);
Begin
  Log(aMessage, Format(aValueMask, aParams), aNeedTime, aNeedTime);
end;

Procedure Log(Const aKind: Integer; Const aMessage: String;
  Const aValue: String; Const aNeedTime: Boolean);
Begin
  RealLog(aKind, aMessage, aValue, ltString, aNeedTime);
end;

Procedure Log(Const aKind: Integer; Const aMessage: String;
  Const aValueMask: String; Const aParams: Array Of Const;
  Const aNeedTime: Boolean);
Begin
  Log(aKind, aMessage, Format(aValueMask, aParams), aNeedTime);
end;

Procedure Log(Const aValue: Integer; Const aNeedTime: Boolean);
Begin
  RealLog(DefaultLogLevel, '', IntToStr(aValue), ltInteger, aNeedTime);
end;

Procedure Log(Const aMessage: String; Const aValue: Integer;
  Const aNeedTime: Boolean);
Begin
  RealLog(DefaultLogLevel, aMessage, IntToStr(aValue), ltInteger, aNeedTime);
end;

Procedure Log(Const aKind: Integer; Const aMessage: String;
  Const aValue: Integer; Const aNeedTime: Boolean);
Begin
  RealLog(aKind, aMessage, IntToStr(aValue), ltInteger, aNeedTime);
end;

Procedure Log(Const aValue: Double; Const aNeedTime: Boolean);
Begin
  RealLog(DefaultLogLevel, '', FloatToStr(aValue), ltDouble, aNeedTime);
end;

Procedure Log(Const aMessage: String; Const aValue: Double;
  Const aNeedTime: Boolean);
Begin
  RealLog(DefaultLogLevel, aMessage, FloatToStr(aValue), ltDouble, aNeedTime);
end;

Procedure Log(Const aKind: Integer; Const aMessage: String;
  Const aValue: Double; Const aNeedTime: Boolean);
Begin
  RealLog(aKind, aMessage, FloatToStr(aValue), ltDouble, aNeedTime);
end;

Procedure Log(Const aValue: TDateTime; Const aFormat: String;
  Const aNeedTime: Boolean);
Begin
  RealLog(DefaultLogLevel, '', FormatDateTime(aFormat, aValue),
    ltDateTime, aNeedTime);
end;

Procedure Log(Const aMessage: String; Const aValue: TDateTime;
  Const aFormat: String; Const aNeedTime: Boolean);
Begin
  RealLog(DefaultLogLevel, aMessage, FormatDateTime(aFormat, aValue),
    ltDateTime, aNeedTime);
end;

Procedure Log(Const aKind: Integer; Const aMessage: String;
  Const aValue: TDateTime; Const aFormat: String; Const aNeedTime: Boolean);
Begin
  RealLog(aKind, aMessage, FormatDateTime(aFormat, aValue),
    ltDateTime, aNeedTime);
end;

Procedure LogStack(Const aMessage: String; Const aNeedTime: Boolean);
Var
  aStream: TMemoryStream;
Begin
  aStream := TMemoryStream.Create;
  RealLog(DefaultLogLevel, aMessage, GetCallStack, ltStack, aNeedTime);
end;

Procedure LogException(Const aException: Exception);
Begin
  RealLog(DefaultLogLevel, aException.ClassName, aException.Message + ':' +
    GetCallStack, ltException, FALSE);
end;

Procedure LogMethodStart(Const aMethodName: String; Const aParams: String;
  Const aNeedTime: Boolean);
Begin
  RealLog(DefaultLogLevel, '*ENTER*', aMethodName, ltMethod, aNeedTime);
end;

Procedure LogMethodStart(Const aMethodName: String; Const aParamsMask: String;
  Const aParams: Array Of Const; Const aNeedTime: Boolean);
Begin
  LogMethodStart(aMethodName, Format(aParamsMask, aParams), aNeedTime);
end;

Procedure LogMethodStop(Const aMethodName: String; Const aNeedTime: Boolean);
Begin
  RealLog(DefaultLogLevel, '*LEAVE*', aMethodName, ltMethod, aNeedTime);
end;

Procedure InitLogging;
Var
  aName: String;
  aHomeDir: String;
  aNoLog: Boolean;
Begin
  {$IFDEF BEasyPublish}
  aPublisher := TFPHTTPClient.Create(nil);
  {$ENDIF}
  aName := ExtractFileName(ParamStr(0));
  If Not(DirectoryExists(GetUserDir + '.bdata')) Then
    mkdir(GetUserDir + '.bdata');
  aHomeDir := GetUserDir + '.bdata' + PathDelim;
  If Not(DirectoryExists(aHomeDir + aName)) Then
    mkdir(aHomeDir + aName);
  aHomeDir := aHomeDir + aName + PathDelim;
  Try
    If FileExists(aHomeDir + 'log.' +
      FormatDateTime('dd.mm.yy', Now) + '.txt') Then
      LogFile := TFileStream.Create(aHomeDir + 'log.' +
        FormatDateTime('dd.mm.yy', Now) +'.txt', fmOpenWrite Or fmShareDenyNone)
    Else
      LogFile := TFileStream.Create(aHomeDir + 'log.'  +
        FormatDateTime('dd.mm.yy', Now) + '.txt', fmCreate);
    LogFile.Seek(0, soEnd);
    LogInitiated := TRUE;
    RealLog(DefaultLogLevel, '*INIT*', '', ltMethod, FALSE);
  Except
    aNoLog := TRUE;
  End;
end;

Finalization
Begin
  RealLog(DefaultLogLevel, '*FIN*', '', ltMethod, FALSE);
  LogFile.Free;
End;

End.

